unit Gradient;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  VCLUtils;

type
  TGradient = class(TGraphicControl)
  private
    { Private declarations }
    FStartColor : TColor;
    FEndColor : TColor;
    FSteps : byte;
    FDirection : TFillDirection;
    FCache : TBitmap;
    FUseCache : boolean;
    procedure SetDirection(const Value: TFillDirection);
    procedure SetEndColor(const Value: TColor);
    procedure SetStartColor(const Value: TColor);
    procedure SetSteps(const Value: byte);
    procedure SetUseCache(const Value: boolean);
  protected
    { Protected declarations }
    procedure Paint; override;
  public
    { Public declarations }
  published
    { Published declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property StartColor: TColor read FStartColor write SetStartColor;
    property EndColor: TColor read FEndColor write SetEndColor;
    property Steps: byte read FSteps write SetSteps;
    property UseCache: boolean read FUseCache write SetUseCache;
    property Direction: TFillDirection read FDirection write SetDirection;
    property Align;
    property Anchors;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Constraints;
    property ParentShowHint;
    property ShowHint;
    property Visible;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('DCF', [TGradient]);
end;

constructor TGradient.Create(AOwner: TComponent);
begin
  inherited;
  ControlStyle := ControlStyle + [csReplicatable];
  Width := 65;
  Height := 65;
  FStartColor := clBlue;
  FEndColor := clBlack;
  FSteps := 64;
  FDirection := fdTopToBottom;
end;

destructor TGradient.Destroy;
begin
  FCache.Free;
  inherited;
end;

procedure TGradient.Paint;
begin
  if FUseCache then
  begin
    if (FCache.Width<>Width) or (FCache.Height<>Height) then
    begin
      FCache.Height := Height;
      FCache.Width  := Width;
      GradientFillRect(FCache.Canvas,Rect(0,0,Width,Height),StartColor,EndColor,Direction,Steps);
    end;
    Canvas.Draw(0,0,FCache);
  end
  else GradientFillRect(Canvas,ClientRect,StartColor,EndColor,Direction,Steps);
end;

procedure TGradient.SetDirection(const Value: TFillDirection);
begin
  if FDirection=Value then exit;
  FDirection := Value;
  Invalidate;
end;

procedure TGradient.SetEndColor(const Value: TColor);
begin
  if FEndColor=Value then exit;
  FEndColor := Value;
  Invalidate;
end;

procedure TGradient.SetStartColor(const Value: TColor);
begin
  if FStartColor=Value then exit;
  FStartColor := Value;
  Invalidate;
end;

procedure TGradient.SetSteps(const Value: byte);
begin
  if FSteps=Value then exit;
  FSteps := Value;
  Invalidate;
end;

procedure TGradient.SetUseCache(const Value: boolean);
begin
  if FUseCache=Value then exit;
  FUseCache := Value;
  if FUseCache then
    FCache := TBitmap.Create
  else
  begin
    FCache.Free;
    FCache := nil;
  end;
end;

end.
